HPAVC/HPAVC CD-ROM.iso/pc/PHANTCYB.ZIP/VGA256.PAS

Pascal/Delphi Source File | 1994-07-15 | 18.9 KB | 644 lines

unit VGA256;

interface

uses Dos,crt;
const SCREEN=$A000;

var p1,p2,p3,p4,p5,p6,p7: pointer;
    bank1,bank2,bank3,bank4,bank5,sys,font: word;
    r,g,b: array[0..255] of byte;

procedure Bar(segm,x1,y1,x2,y2: word; c: byte);
procedure Polygon(segm,x1,y1,x2,y2,x3,y3,x4,y4: word; c: byte);
procedure Checkers(segm: word);
procedure ShowBank(segm: word);
procedure LoadBank(s: string; segm: word);
procedure SaveBank(s: string; segm: word);
procedure DefaultPalette;
procedure InitBanks;
procedure LoadScreen(s: string; p: pointer);
procedure InitScreen;
procedure CloseScreen;
procedure Palette (n,r,g,b: byte);
procedure NCls(c: byte);
procedure Hline (x1,y1,l,c: integer);
procedure Vline (x1,y1,l,c: integer);
procedure WaitVbl;
procedure Mode(n: byte);
procedure Plasma(segm: word);
procedure Plasma256(segm: word);
procedure C_Plasma(segm: word; F: byte; h1,v1,h2,v2,minv,maxv: integer);
procedure C_Plasma256(segm: word; F: byte; h1,v1,h2,v2,minv,maxv: integer);

implementation

procedure Bar(segm,x1,y1,x2,y2: word; c: byte); Assembler;
{Optimized ofcourse... Draws a bar using words in selected segment}
var linec,width: word;
label lines,drawwords,pixels,exit;
asm
   mov DI,[y1]             {Calculate screenaddress}
   mov BX,DI
   shl BX,6
   shl DI,8
   add DI,BX
   add DI,[x1]
   mov CX,[y2]             {Calculate number of lines}
   sub CX,[y1]
   mov [linec],CX
   mov CX,[x2]             {Calculate width of square}
   sub CX,[x1]
   mov [width],CX
   mov ES,[segm]           {Output segment}
   mov AL,[c]              {Pixel color}
   mov AH,AL
lines:
   mov CX,[width]          {Load pixelcounter}
   mov SI,DI               {Load addresscounter}
   add DI,320              {Increase linestartaddress}
   mov BX,SI
   and BX,1                {odd?}
   jz drawwords
   mov ES:[SI],AL          {then draw one pixel}
   inc SI
   dec CX
   jz exit                 {No more pixels}
drawwords:
   mov BX,CX
   shr CX,1                {Words=bytes/2}
   jz exit
pixels:
   mov ES:[SI],AX
   add SI,2
   loop pixels
   and BX,1                {Last odd pixel?}
   jz exit
   mov ES:[SI],AL
exit:
   dec [linec]
   jnz lines
end;

procedure Polygon(segm,x1,y1,x2,y2,x3,y3,x4,y4: word; c: byte);
{Draws a polygon with four edges with color c in a bank or on screen}
label pixels1,pixels2,pixels3,pixels4,clear,lines,drawit,nodraw
      ,skip1a,skip1b,skip2a,skip2b,skip3a,skip3b,skip4a,skip4b
      ,drawword,startfast,lastodd;
var x,y: array[1..5] of word;
    xs: word;
    dy: integer;
    dx: word;
    i,l: word;
    a,b: word;
    h1,v1: word;
    loopc: word;
begin
   x[1]:=x1; y[1]:=y1;
   x[2]:=x2; y[2]:=y2;
   x[3]:=x3; y[3]:=y3;
   x[4]:=x4; y[4]:=y4;
   x[5]:=x1; y[5]:=y1;
   {Clear the start-end-of-horizontal-line table}
   asm
      mov AX,[sys]
      mov ES,AX
      mov DI,0
      mov CX,200
   clear:
      mov word ptr ES:[DI],320       {min value at current line}
      mov word ptr ES:[DI+2],0       {max value at current line}
      add DI,4
      loop clear
   end;
   {Draw lines}
   for i:=1 to 4 do begin
      b:=0;
      if abs(y[i]-y[i+1])>0 then begin
         if y[i]<y[i+1] then begin
            if x[i]<x[i+1] then begin
               h1:=x[i];
               v1:=y[i];
               dx:=x[i+1]-h1;
               dy:=y[i+1]-v1;
               xs:=(dx shl 7) div dy;
               asm
                  mov AX,[sys]          {write min&max values in bank6}
                  mov ES,AX
                  mov DI,[v1]           {first line to fill}
                  shl DI,2              {4 bytes per line}
                  mov BX,[h1]           {get start-x for line}
                  shl BX,7              { *127 }
                  mov DX,[xs]           {x-displacement per line}
                  mov CX,[dy]
               pixels1:
                  mov SI,BX             {get x}
                  shr SI,7              {divide by 127}
                  cmp SI,ES:[DI]        {smaller than min at this line?}
                  jae skip1a
                  mov ES:[DI],SI        {replace min}
               skip1a:
                  cmp SI,ES:[DI+2]      {greater than max at this line?}
                  jbe skip1b
                  mov ES:[DI+2],SI      {replace max}
               skip1b:
                  add DI,4              {next line}
                  add BX,DX             {update x-coord}
                  loop pixels1          {next pixel}
               end;
            end else begin
               h1:=x[i+1];
               v1:=y[i+1];
               dx:=x[i]-h1;
               dy:=v1-y[i];
               xs:=(dx shl 7) div dy;
               asm
                  mov AX,[sys]          {write min&max values in bank6}
                  mov ES,AX
                  mov DI,[v1]           {first line to fill}
                  shl DI,2              {4 bytes per line}
                  mov BX,[h1]           {get start-x for line}
                  shl BX,7              { *127 }
                  mov DX,[xs]           {x-displacement per line}
                  mov CX,[dy]
               pixels2:
                  mov SI,BX             {get x}
                  shr SI,7              {divide by 127}
                  cmp SI,ES:[DI]        {smaller than min at this line?}
                  jae skip2a
                  mov ES:[DI],SI        {replace min}
               skip2a:
                  cmp SI,ES:[DI+2]      {greater than max at this line?}
                  jbe skip2b
                  mov ES:[DI+2],SI      {replace max}
               skip2b:
                  sub DI,4              {next line}
                  add BX,DX             {update x-coord}
                  loop pixels2          {next pixel}
               end;
            end
         end else begin
            if x[i]>x[i+1] then begin
               h1:=x[i+1];
               v1:=y[i+1];
               dx:=x[i]-h1;
               dy:=y[i]-v1;
               xs:=(dx shl 7) div dy;
               asm
                  mov AX,[sys]          {write min&max values in bank6}
                  mov ES,AX
                  mov DI,[v1]           {first line to fill}
                  shl DI,2              {4 bytes per line}
                  mov BX,[h1]           {get start-x for line}
                  shl BX,7              { *127 }
                  mov DX,[xs]           {x-displacement per line}
                  mov CX,[dy]
               pixels3:
                  mov SI,BX             {get x}
                  shr SI,7              {divide by 127}
                  cmp SI,ES:[DI]        {smaller than min at this line?}
                  jae skip3a
                  mov ES:[DI],SI        {replace min}
               skip3a:
                  cmp SI,ES:[DI+2]      {greater than max at this line?}
                  jbe skip3b
                  mov ES:[DI+2],SI      {replace max}
               skip3b:
                  add DI,4              {next line}
                  add BX,DX             {update x-coord}
                  loop pixels3          {next pixel}
               end;
            end else begin
               h1:=x[i];
               v1:=y[i];
               dx:=x[i+1]-h1;
               dy:=v1-y[i+1];
               xs:=(dx shl 7) div dy;
               asm
                  mov AX,[sys]          {write min&max values in bank6}
                  mov ES,AX
                  mov DI,[v1]           {first line to fill}
                  shl DI,2              {4 bytes per line}
                  mov BX,[h1]           {get start-x for line}
                  shl BX,7              { *127 }
                  mov DX,[xs]           {x-displacement per line}
                  mov CX,[dy]
               pixels4:
                  mov SI,BX             {get x}
                  shr SI,7              {divide by 127}
                  cmp SI,ES:[DI]        {smaller than min at this line?}
                  jae skip4a
                  mov ES:[DI],SI        {replace min}
               skip4a:
                  cmp SI,ES:[DI+2]      {greater than max at this line?}
                  jbe skip4b
                  mov ES:[DI+2],SI      {replace max}
               skip4b:
                  sub DI,4              {next line}
                  add BX,DX             {update x-coord}
                  loop pixels4          {next pixel}
               end;
            end;
         end;
      end;
   end;
   {determine highest and lowest y-coord}
   i:=0;        {highest}
   l:=200;      {lowest}
   for a:=1 to 4 do begin
      if y[a]<l then l:=y[a];
      if y[a]>i then i:=y[a];
   end;
   {Now draw the horizontal lines really fast using words}
   asm
      mov CX,[i]                     {last line to draw}
      mov DI,[l]                     {first line to draw}
      sub CX,DI                      {number of lines to draw}
      mov [loopc],CX
      mov AX,DI
      mov SI,DI                      {min-max table pointer}
      shl SI,2
      shl AX,6
      shl DI,8
      add DI,AX                      {DI=startline *320}
      mov ES,[segm]
      mov AL,[c]
      mov AH,AL
      push DS
      mov DS,[sys]                   {min-max table segment}
   lines:
      mov BX,DS:[SI]                 {startpos of current line}
      mov CX,DS:[SI+2]               {endpos of current line}
      inc CX
      sub CX,BX                      {length of current line}
   drawit:
      mov DX,BX                      {odd?}
      and DX,1
      jz  startfast                  {no:  start drawing words}
      mov ES:[DI+BX],AL              {yes: draw the odd pixel}
      inc BX                         {now it's even}
      dec CX                         {was this the last pixel?}
      jz  nodraw                     {then quit}
   startfast:
      mov DX,CX
      shr CX,1                       {how many words?}
      jz  lastodd                    {none}
   drawword:
      mov ES:[DI+BX],AX
      add BX,2
      loop drawword
   lastodd:
      and DX,1
      jz  nodraw
      mov ES:[DI+BX],AL
   nodraw:
      add SI,4                       {next min-max line}
      add DI,320                     {next screen-line}
      dec [loopc]
      jnz lines
      pop DS
   end;
end;


procedure Checkers(segm: word);
{Draws a nice checkers-pattern in a memory bank (256x256)}
var x,y,h,v,a: word;
begin
   for y:=0 to 15 do for x:=0 to 15 do if odd(x+y) then begin
      a:=x*16+y*16*256;
      for h:=0 to 15 do for v:=0 to 15 do mem[segm:a+h+v shl 8]:=255;
   end;
end;

procedure ShowBank(segm: word);
{Copy the contents of a bank to the screen (only first 64000 bytes,
 320x200 format, current palette) }
var i: word;
begin
   for i:=0 to 13999 do meml[$a000:i shl 2]:=meml[segm:i shl 2];
end;

procedure LoadBank(s: string; segm: word);
{Load a bank from disk}
var f: file;
begin
   assign(f,s);
   reset(f,1);
   if segm=bank1 then BlockRead(f,p1^,65535);
   if segm=bank2 then BlockRead(f,p2^,65535);
   if segm=bank3 then BlockRead(f,p3^,65535);
   if segm=bank4 then BlockRead(f,p4^,65535);
   if segm=bank5 then BlockRead(f,p5^,65535);
   close(f);
end;

procedure SaveBank(s: string; segm: word);
{Save a bank to disk}
var f: file;
begin
   assign(f,s);
   rewrite(f,1);
   if segm=bank1 then BlockWrite(f,p1^,65535);
   if segm=bank2 then BlockWrite(f,p2^,65535);
   if segm=bank3 then BlockWrite(f,p3^,65535);
   if segm=bank4 then BlockWrite(f,p4^,65535);
   if segm=bank5 then BlockWrite(f,p5^,65535);
   close(f);
end;

procedure ClearBank(segm: word); Assembler;
{Clear the contents of a memory bank}
label clear;
asm
   mov ES,[segm]
   mov DI,0
   mov CX,32767
clear:
   mov word ptr ES:[DI],0
   add DI,2
   loop clear
end;

procedure InitBanks;
{Initialize the memory banks}
begin
   GetMem(p1,65535);
   GetMem(p2,65535);
   GetMem(p3,65535);
   GetMem(p4,65535);
   GetMem(p5,65535);
   GetMem(p6,32767);
   GetMem(p7,32767);
   bank1:=Seg(p1^);
   bank2:=Seg(p2^);
   bank3:=Seg(p3^);
   bank4:=Seg(p4^);
   bank5:=Seg(p5^);
   sys:=Seg(p6^);
   font:=Seg(p7^);
   ClearBank(bank1);
   ClearBank(bank2);
   ClearBank(bank3);
   ClearBank(bank4);
   ClearBank(bank5);
   ClearBank(sys);
   ClearBank(font);
end;

procedure DefaultPalette;
{Create a simple greyscale-palette}
var i: byte;
begin
   for i:=0 to 255 do palette(i,i div 4,i div 4,i div 4);
end;

procedure LoadScreen(s: string; p: pointer);
{Load a screen from disk, including the palette}
var f: file;
   i: integer;
   s1,o1: word;
begin
   s1:=Seg(p^);
   o1:=Ofs(p^);
   assign(f,s);
   Reset(f,1);
   BlockRead(f,p^,9);
   BlockRead(f,p^,64000);
   BlockRead(f,p^,256*3);
   for i:=0 to 255 do begin
      r[i]:=mem[s1:o1+i*3];
      g[i]:=mem[s1:o1+i*3+1];
      b[i]:=mem[s1:o1+i*3+2];
      palette(i,r[i],g[i],b[i]);
   end;
   reset(f,1);
   BlockRead(f,p^,9);
   BlockRead(f,p^,64000);
end;

procedure InitScreen;
{Initialize 320x200x256 MCGA mode}
var i: word;
begin
   Inline($B8/$13/0/$CD/$10);
   NCls(0);
   for i:=0 to 255 do palette(i,i div 4,i div 4,i div 4);
end;

procedure CloseScreen;
{Return to textmode}
begin
   Textmode(Lastmode);
end;

Procedure Palette (n,r,g,b: byte);
{Change the palette}
Begin Port[$3C8] := n;
      Port[$3C9] := r;
      Port[$3C9] := g;
      Port[$3C9] := b;
End;

procedure NCls(c: byte);
{Clear the screen}
var i: word;
    cc: longint;
begin
   cc:=c+c*256+c*65536+c*65536*256;
   for i:=0 to $3e7f do meml[$a000:4*i]:=cc
end;

procedure Line(x1,y1,x2,y2,c: integer);
{Draw a line}
   var dx,dy,l: real; i,z: integer;
begin
   l:=sqrt(abs((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)));
   dx:=(x2-x1)/l;
   dy:=(y2-y1)/l;
   z:=x1+y1*320;
   for i:=1 to round(l) do mem[$a000:z+round(i*dx)+320*round(i*dy)]:=c
end;

procedure Hline(x1,y1,l,c: integer);
{Draw a horizontal line}
   var i,z: word;
       q: word;
begin
   z:=x1+y1*320;
   q:=c+256*c;
   while l>1 do begin
      l:=l-2;
      memw[$a000:z]:=q;
      z:=z+2
   end;
   for i:=1 to l do mem[$a000:z+i-1]:=c
end;

procedure Vline(x1,y1,l,c: integer);
{Draw a vertical line}
   var i,z: integer;
begin
   z:=x1+y1*320;
   for i:=0 to l-1 do mem[$a000:z+i*320]:=c
end;

procedure WaitVbl; assembler;
{Wait for sync}
label
  l1, l2;
asm
    cli
    mov dx,3DAh
l1:
    in al,dx
    and al,08h
    jnz l1
l2:
    in al,dx
    and al,08h
    jz  l2
    sti
end;

procedure Mode (n: byte);
{Initialize mode n}
begin
   asm
     mov  AH,00
     mov  AL,n
     Int  10h
   end;
end;

procedure Plasma(segm: word);
{Draw a default plasma (320x200) }
begin
   C_Plasma(segm,2,0,0,319,199,1,255);
end;

procedure Plasma256(segm: word);
{Draw a default plasma (256x256) }
begin
   C_Plasma256(segm,2,0,0,255,255,1,255);
end;

procedure C_Plasma(segm: word; F: byte; h1,v1,h2,v2,minv,maxv: integer);
{Draw a customized plasma}
var i: longint;
    x,y: word;
  procedure subDivide(x1,y1,x2,y2: integer);
    var
      x,y: word;          {OPTIMIZED BY THE PHANTOM}
      v: integer;         {SPEED GAIN APPROX. 400% }
  begin
    if x2-x1>=2 then begin
       x:=(x1+x2) shr 1;
       y:=(y1+y2) shr 1;
       if mem[segm:x+y1*320]=0 then begin
          v:=round(((mem[segm:x1+y1*320]+mem[segm:x2+y1*320]) shr 1)+
             (random-0.5)*(x2-x1)*F);
          if v<minv then v:=minv;
          if v>maxv then v:=maxv;
          mem[segm:x+y1*320]:=v;
       end;
       if mem[segm:x2+y*320]=0 then begin
          v:=round(((mem[segm:x2+y1*320]+mem[segm:x2+y2*320]) shr 1)+
             (random-0.5)*(y2-y1)*F);
          if v<minv then v:=minv;
          if v>maxv then v:=maxv;
          mem[segm:x2+y*320]:=v
       end;
       if mem[segm:x+y2*320]=0 then begin
          v:=round(((mem[segm:x1+y2*320]+mem[segm:x2+y2*320]) shr 1)+
             (random-0.5)*(x1-x2)*F);
          if v<minv then v:=minv;
          if v>maxv then v:=maxv;
          mem[segm:x+y2*320]:=v
       end;
       if mem[segm:x1+y*320]=0 then begin
          v:=round(((mem[segm:x1+y1*320]+mem[segm:x1+y2*320]) shr 1)+
             (random-0.5)*(y2-y1)*F);
          if v<minv then v:=minv;
          if v>maxv then v:=maxv;
          mem[segm:x1+y*320]:=v
       end;
       if mem[segm:x+y*320]=0 then
           mem[segm:x+y*320]:=(mem[segm:x1+y1*320]+mem[segm:x2+y1*320]
           +mem[segm:x2+y2*320]+mem[segm:x1+y2*320]) shr 2;
       subDivide(x1,y1,x,y);
       subDivide(x,y1,x2,y);
       subDivide(x,y,x2,y2);
       subDivide(x1,y,x,y2)
     end
  end;
begin
  Randomize;
  for x:=h1 to h2 do for y:=v1 to v2 do mem[segm:x+y*320]:=0;
  mem[segm:h1+v1*320]:=Random(maxv-minv)+minv;
  mem[segm:h2+v1*320]:=Random(maxv-minv)+minv;
  mem[segm:h2+v2*320]:=Random(maxv-minv)+minv;
  mem[segm:h1+v2*320]:=Random(maxv-minv)+minv;
  subDivide(h1,v1,h2,v2);
end;

procedure C_Plasma256(segm: word; F: byte; h1,v1,h2,v2,minv,maxv: integer);
{Draw a customized plasma}
var i: longint;
    x,y: word;
  procedure subDivide(x1,y1,x2,y2: integer);
    var
      x,y: word;          {OPTIMIZED BY THE PHANTOM}
      v: integer;         {SPEED GAIN APPROX. 400% }
  begin
    if x2-x1>=2 then begin
       x:=(x1+x2) shr 1;
       y:=(y1+y2) shr 1;
       if mem[segm:x+y1 shl 8]=0 then begin
          v:=round(((mem[segm:x1+y1 shl 8]+mem[segm:x2+y1 shl 8]) shr 1)+
             (random-0.5)*(x2-x1)*F);
          if v<minv then v:=minv;
          if v>maxv then v:=maxv;
          mem[segm:x+y1 shl 8]:=v;
       end;
       if mem[segm:x2+y shl 8]=0 then begin
          v:=round(((mem[segm:x2+y1 shl 8]+mem[segm:x2+y2 shl 8]) shr 1)+
             (random-0.5)*(y2-y1)*F);
          if v<minv then v:=minv;
          if v>maxv then v:=maxv;
          mem[segm:x2+y shl 8]:=v
       end;
       if mem[segm:x+y2 shl 8]=0 then begin
          v:=round(((mem[segm:x1+y2 shl 8]+mem[segm:x2+y2 shl 8]) shr 1)+
             (random-0.5)*(x1-x2)*F);
          if v<minv then v:=minv;
          if v>maxv then v:=maxv;
          mem[segm:x+y2 shl 8]:=v
       end;
       if mem[segm:x1+y shl 8]=0 then begin
          v:=round(((mem[segm:x1+y1 shl 8]+mem[segm:x1+y2 shl 8]) shr 1)+
             (random-0.5)*(y2-y1)*F);
          if v<minv then v:=minv;
          if v>maxv then v:=maxv;
          mem[segm:x1+y shl 8]:=v
       end;
       if mem[segm:x+y shl 8]=0 then
           mem[segm:x+y shl 8]:=(mem[segm:x1+y1 shl 8]+mem[segm:x2+y1 shl 8]
           +mem[segm:x2+y2 shl 8]+mem[segm:x1+y2 shl 8]) shr 2;
       subDivide(x1,y1,x,y);
       subDivide(x,y1,x2,y);
       subDivide(x,y,x2,y2);
       subDivide(x1,y,x,y2)
     end
  end;
begin
  Randomize;
  for x:=h1 to h2 do for y:=v1 to v2 do mem[segm:x+y shl 8]:=0;
  mem[segm:h1+v1 shl 8]:=Random(maxv-minv)+minv;
  mem[segm:h2+v1 shl 8]:=Random(maxv-minv)+minv;
  mem[segm:h2+v2 shl 8]:=Random(maxv-minv)+minv;
  mem[segm:h1+v2 shl 8]:=Random(maxv-minv)+minv;
  subDivide(h1,v1,h2,v2);
end;

end.